perm filename OUTDPY.FAI[LIB,ROB] blob sn#367836 filedate 1980-07-07 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00003 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002		title outdpy
C00009 00003	a←1 ↔ b←2 ↔ c←3 ↔ d←4 ↔ e←5 ↔ chpos←6 ↔ dpytyp←14
C00020 ENDMK
C⊗;
	title outdpy
	entry outdpy,outdp2
	extern outstr,corget,correl

comment ⊗

This subroutine was written for dd's by pmf.  The iii and dm routines, along with
the column-positioning, was added by don on 4-May-78.

Outdpy is a sail-callable procedure for displaying text on datadiscs, iiis,
and datamedias.  The declaration within the sail program is:

require "outdpy.rel[s,pmf]" library;
external procedure outdpy (string mess; integer string_pos, pp_pos);

where:	mess		is the text to be displayed
	string_pos	is the position where the first char should go (see below)
	pp_pos		is the position for the page printer (see below)

Lines which are partially occupied by  the message will be cleared to  the
right margin; this will not be the  case for blank lines in the text.   To
get them truly blank, include at least one space character.

If the terminal is  not a display, the  sail function "outstr" is  invoked
instead.

The value of string_pos should  be x,,y (i.e. (x lsh  18)+y) where x is  a
column and y is a  line.  Columns are numbered from  1 to n (n depends  on
the display type); a  column of zero  will put text  at the standard  left
margin (column 2 on dd's  and iii's, column 1  on dm's); a column  greater
than the right margin (99 is  big enough regardless of the terminal  type)
will put text  at the column  used for  "Page xx" by  the "copy"  program.
Only the first  line of text  starts at the  specified column;  subsequent
lines, if any, will start at  the standard left margin.  Meanwhile,  lines
are numbered from  0 (system wholine)  through m (again  depending on  the
terminal).  Line 3 is  the standard "first  line", 2 is  the line used  by
"copy" for page  numbers, etc.   Finally, if string_pos  is negative,  the
screen is erased  before the display  is done, and  the absolute value  is
used to determine the x/y coordinates for the text.

The value of pp_pos  should be a  line number, where  0 again denotes  the
system wholine.  If pp_pos is negative, the page printer is positioned  to
leave |pp_pos| blank lines  between the last line  of the message and  the
first line of the printer.  The size of the page printer is set to  extend
as near as  possible to the  bottom of  the screen, with  the glitch  size
being the default for the particular terminal (4 for dd's, 2 for iii's,  3
for dm's) unless this would result in  only 1 glitch per screen, in  which
case a smaller glitch is used.

For wizards who want to  save a bit of overhead,  or who want to  suppress
certain features of outdpy, there is outdp2.  Its declaration is:

external procedure outdp2 (string mess; integer string_pos, pp_pos, specs);

The first three parameters are the same as for outdpy.  The remaining
parameter, specs, is interpreted as follows:
	400000,,0	If set, suppress the page-printer stuff (pp_pos
			is thus ignored).  Also suppresses check for bottom
			of screen (outdpy cuts the display short once it
			hits enough linefeeds to reach the bottom of the
			display; this is obviously a loss if one is trying
			to play games with DM cursor positioning).
	377777,,0	Used as the flag bits in the upgiot uuo (see uuo
			manual for details); octal 251000 is what outdpy
			uses.  The 20000 bit suppresses clearing to end
			of line on dm's; if this bit is set, outdp2 also
			does the right stuff to suppress clearing to end
			of line on dd's.
	0,,777000	Currently unused.
	0,,000740	POG to use if iii (from 0 to 17, outdpy uses 0).
	0,,000037	Display type (outdp2 depends on the caller for
			the correct display type), 0=iii, 1=dm, 2=dd,
			anything else is non-display (outdp2 jrsts to
			outstr).
Outdp2 also does not bother enforcing the limits on the string position,
except for the default left margin if the character position is 0.

⊗;
a←1 ↔ b←2 ↔ c←3 ↔ d←4 ↔ e←5 ↔ chpos←6 ↔ dpytyp←14
pnt←10 ↔ len←11 ↔ spos←13 ↔ ppos←7 ↔ specs←15
sp←16 ↔ p←17

rmin←←1 ↔ rmax←←15			;regs to save when corgetting

iiibit←←400000 ↔ dmbit←←40000 ↔ ddbit←←20000	;line bits for dpy types
iii←←0 ↔ dm←←1 ↔ dd←←2				;indices for dpy types

define cw(c1,b1,c2,b2,c3,b3)
<	<byte(8)<b1>,<b2>,<b3>(3)<c1>,<c2>,<c3>>!4>	;dd control word


buffpt:	251000,,0			;dblfield+trunc+noeeob+chaste,,buffer addr
	0				;length of buffer
	0				;done-flag (ignored)
	0				;second field address (buffer+1)

outdp2:	move spos,-3(p)			;get first parm
	pop p,-3(p)			;move return addr on top of parm
	pop p,specs			;get third parm
	pop p,ppos			;get second parm, leave stack looking good
	hrre dpytyp,specs		;what kind of terminal is this?
	andi dpytyp,37
	caile dpytyp,dd
	 jrst outstr			;not a dpy, let outstr do its thing
	skipge spos			;if string position < 0 erase screen
	 xct erstbl(dpytyp)
	movm spos,spos
	hlrz chpos,spos			;get horiz position from left half of spos
	hrrz spos,spos			;(don't bother checking for off-screen)
	jrst join			;join normal routine

outdpy:	move spos,-2(p)			;get first parm
	pop p,-2(p)			;move return addr on top of parm
	pop p,ppos			;get second parm, leave stack looking good
	
	setob a,dpytyp
	getlin a			;get type of terminal
	tlne a,iiibit
	 movei dpytyp,iii
	tlne a,dmbit
	 movei dpytyp,dm
	tlne a,ddbit
	 movei dpytyp,dd
	jumpl dpytyp,outstr		;not a dpy - let outstr handle it
	movsi specs,251000		;ensure pg prtr gets pos'ned, default flags

	skipge spos			;if string position < 0 erase screen
	 xct erstbl(dpytyp)
	movm spos,spos

	hlrz chpos,spos			;get horiz position from left half of spos
	hrrz spos,spos
	camle spos,maxlin(dpytyp)	;restrict range, enforce defaults
	 move spos,maxlin(dpytyp)
	camle chpos,maxrit(dpytyp)
	 move chpos,chdefr(dpytyp)
join:	caig chpos,0
	 move chpos,chdefl(dpytyp)

	pop sp,pnt			;get string byte pointer
	pop sp,len			;get length of string
	hrre len,len
	jumple len,cpopj		;null string
	movei c,=21(len)		;find number of words for string
					;21=4 for rounding, 2 for crlf at end,
					;	and 3*5 for control words
	idivi c,5
	jrst .+1
	movem rmin,regsav		;corget routine mungs some regs
	move rmin,[rmin+1,,regsav+1]	;prepare to blt
	blt rmin,regsav+rmax-rmin	;save regs rmin+1 thru rmax
	pushj p,corget
	 halt
	movem 12,regsav+12-rmin		;don't argue if corget wants to mung r12
	movem b,regsav+b-rmin		;and b contains addr of core gotten
	move rmin,[regsav+1,,rmin+1]
	blt rmin,rmax			;restore regs
	move rmin,regsav

	hrrm b,buffpt			;set up ptrs and length for upgiot uuo
	hrrm c,buffpt+1
	movei a,1(b)
	hrrm a,buffpt+3
	hrli a,(b)			;blt to zero in case string is truncated
	movei d,(b)
	addi d,-1(c)
	setzm (b)
	blt a,(d)

	hrli d,(<point 7,0>)		;copy string
	hrri d,2(b)
	move e,spos
	sub e,maxlin(dpytyp)		;number of lines to bottom
	tlne specs,400000		;not doing pp stuff?
	 movsi e,400000			;right, don't bother counting lf's
copyit:	ildb a,pnt
	cain a,12			;look for line feeds
	 aojg e,bottom			;e contains count of line feeds
	idpb a,d
	sojg len,copyit

	caie dpytyp,dd			;if dd need to append crlf to the string
	 jrst bottom
	movei a,15
	idpb a,d
	movei a,12
	idpb a,d

bottom:	jumpl specs,nopp		;don't adjust page printer if specs < 0
	jumpge ppos,pp
	movn ppos,ppos			;ppos < 0 is relative to last line of string
	add ppos,e
	add ppos,maxlin(dpytyp)

pp:	pushj p,setpp			;set the page printer
nopp:	tlz specs,400000		;turn off specs bit before using in upgiot

	hrlzi a,-3(c)			;set bit 35 of ascii string words to 1
	movn a,a
	hrri a,2(b)
	movei d,1
or1bit:	iorm d,(a)
	aobjn a,or1bit

	xct word0(dpytyp)		;get control words for this type of dpy
	movem a,(b)			;and put them at front of dpy prog
	xct word1(dpytyp)
	movem a,1(b)

	hllm specs,buffpt		;stash upgiot flags (default 251000)
	ldb a,[point 4,specs,=30]	;get pog number in case iii
	dpb a,[point 4,.+1,=12]
	upgiot buffpt

	pushj p,correl

cpopj:	popj p,


setpp:	camle ppos,maxlin(dpytyp)
	 move ppos,maxlin(dpytyp)
	caige ppos,0
	 movei ppos,0

	movn d,ppos
	add d,maxlin(dpytyp)
	addi d,1			;number of lines left for page printer
	move a,glchsz(dpytyp)		;get preferred glitch-size (doubled)
setpp0:	caige d,(a)			;reduce glitch size till room for 2 glitches
	 caig a,2			;but don't reduce past 1 (doubled)
	  jrst setpp1
	subi a,2
	jrst setpp0

setpp1:	lsh a,-1			;undouble the glitch size
	idivi d,(a)			;number of glitches
	lsh d,=9
	addi a,(d)
	pushj p,@ppcalc(dpytyp)		;convert ppos to dpypos arg (less 1000) in d
	dpypos 1000(d)
	dpysiz (a)
	popj p,

maxlin:	=41				;last line on iii (top is line 0)
	=23				;dm
	=39				;dd

maxrit:	=87				;rightmost column on iii (leftmost is 1)
	=80				;dm
	=85				;dd

chdefl:	=2				;default column on iii if chpos < 1
	=1				;dm
	=2				;dd

chdefr:	=75				;default column on iii if chpos > maxrit
	=71				;dm
	=64				;dd

glchsz:	2*2				;max lines per glitch on iii (doubled)
	3*2				;dm
	4*2				;dd


erstbl:	pgclr				;clearing iii is easy
	upgiot ersdm			;dm requires dpy prog
	upgiot ersdd			;so does dd

edmbuf:	byte (7)177,37			;erase dm screen
ersdm:	edmbuf
	ersdm-edmbuf
	0
	0

eddbuf:	cw 1,17,2,0,1,46		;erase dd
	0
ersdd:	eddbuf
	ersdd-eddbuf
	0
	0


word0:	setz a,				;junk word needed at front of iii dpy prog
	setz a,				;null word ignored by dm
	pushj p,ddwd0			;get function/screen select for dd

ddwd0:	move a,[cw 1,46,2,0,1,46]	;function/screen select for dd
	tlne specs,20000		;is dm bit for non-erasing set in flags?
	addi a,<cw 1,46,2,0,1,66>-<cw 1,46,2,0,1,46>  ;yes, do same for dd
	popj p,

word1:	pushj p,iiiwd1			;form position-word for iii in a
	pushj p,dmwd1			;dm
	pushj p,ddwd1			;dd

iiiwd1:	movei a,1146			;same brightness, inv vec, absolute, chsiz=2
	move d,[point =11,a]		;ptr to stuff x,y into top of a
	subi chpos,=44			;iii address is relative to screen center
	imuli chpos,=12
	subi chpos,6
	idpb chpos,d
	subi spos,=21
	imuli spos,=24
	movn spos,spos
	idpb spos,d
	popj p,

dmwd1:	movsi a,(<byte(7)177,14,0,0,0>)	;dm x,y-select command (to be filled in)
	tlne specs,100000		;is dmquot bit set?
	 tlz a,(<byte(7)177,0,0,0,0>)	;yes, don't need 177 before command
	move d,[point 7,a,=13]
	subi chpos,1
	xori chpos,140
	idpb chpos,d
	xori spos,140
	idpb spos,d
	popj p,

ddwd1:	move a,[cw 3,0,4,0,5,0]
	move d,[point 8,a]		;ptr to stuff into operand-bytes of cw
	idpb chpos,d			;column select
	imuli spos,=12
	rot spos,-4
	idpb spos,d			;high 5 bits of row select
	rot spos,4
	andi spos,17
	idpb spos,d			;low 4 bits
	popj p,


ppcalc:	iiipp				;convert ppos to dpypos for iii
	dmpp				;dm
	ddpp				;dd

ddpp:	movei d,1(ppos)
	lsh d,7
	idiv d,[-5]
	popj p,

iiipp:	movei d,(ppos)
	imul d,[-30]
	subi d,10
	popj p,

dmpp:	movei d,1(ppos)
	lsh d,7
	idiv d,[-3]
	popj p,


regsav:	block	rmax-rmin+1


	end